home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / PAINT.PAK / PALETTE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  4KB  |  136 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows: Paint Demo         }
  4. {   Palette unit                                 }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit Palette;
  10.  
  11. { This unit defines a color palette window for the Paint program. The color
  12.   palette is responsible for displaying the available colors, maintaining
  13.   and displaying the current pen and brush colors and provides the interface
  14.   for color selection.
  15. }
  16.  
  17. interface
  18.  
  19. uses PaintDef, WinTypes, WinProcs, WObjects;
  20.  
  21. type
  22.  
  23.   PPalette = ^TPalette;
  24.   TPalette = object(TWindow)
  25.     State: PState;
  26.  
  27.     { Creation }
  28.     constructor Init(AParent: PWindowsObject; AState: PState);
  29.  
  30.     { Utility }
  31.     procedure SelectColor(var Msg: TMessage; var Color: TColorRef);
  32.  
  33.     { Display }
  34.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  35.  
  36.     { Window manager responses }
  37.     procedure WMLButtonDown(var Msg: TMessage);
  38.       virtual wm_First + wm_LButtonDown;
  39.     procedure WMRButtonDown(var Msg: TMessage);
  40.       virtual wm_First + wm_RButtonDown;
  41.   end;
  42.  
  43. implementation
  44.  
  45. const
  46.  
  47.   { The available colors in RGB format }
  48.   Colors: array[0..2, 0..15] of TColorRef = (
  49.     ($FFFFFF,$E0E0E0,$C0C0FF,$C0E0FF,$E0FFFF,$C0FFC0,$FFFFC0,$FFC0C0,
  50.      $FFC0FF,$0000C0,$0040C0,$00C0C0,$00C000,$C0C000,$C00000,$C000C0),
  51.     ($C0C0C0,$404040,$8080FF,$80C0FF,$80FFFF,$80FF80,$FFFF80,$FF8080,
  52.      $FF80FF,$000080,$004080,$008080,$008000,$808000,$800000,$800080),
  53.     ($808080,$000000,$0000FF,$0080FF,$00FFFF,$00FF00,$FFFF00,$FF0000,
  54.      $FF00FF,$000040,$404080,$004040,$004000,$404000,$400000,$400040));
  55.  
  56.  
  57. { Create the palette.
  58. }
  59. constructor TPalette.Init(AParent: PWindowsObject; AState: PState);
  60. begin
  61.   TWindow.Init(AParent, nil);
  62.   Attr.Style := ws_Child or ws_Visible;
  63.   State := AState;
  64. end;
  65.  
  66. { Set the Color variable to the color pressed on in the palette window.
  67.   (Mouse click information contained in Msg.)
  68.   Cause the display to be updated.
  69. }
  70. procedure TPalette.SelectColor(var Msg: TMessage; var Color: TColorRef);
  71. var
  72.   X, Y, S: Integer;    { Column, Row clicked on; Height of color squares }
  73.   R: TRect;        { Window client area }
  74. begin
  75.   GetClientRect(HWindow, R);
  76.   S := R.bottom div 17;
  77.   X := Msg.LParamLo div S;
  78.   Y := Msg.LParamHi div S;
  79.   if (X < 3) and (Y < 16) then
  80.   begin
  81.     Color := Colors[X, Y];
  82.     InvalidateRect(HWindow, nil, False);
  83.   end;
  84. end;
  85.  
  86. { Paint the palette window by painting the available colors in 3 columns of
  87.   16 rows. The 17th row spans all three columns and is used to display the
  88.   currently selected pen and brush colors.
  89. }
  90. procedure TPalette.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  91. var
  92.   X, Y, S: Integer;    { Column, Row; Height of row }
  93.   OldPen: HPen;        { Original pen in drawing context }
  94.   OldBrush: HBrush;    { Original brush in drawing context }
  95.   R: TRect;        { Window client area }
  96. begin
  97.   GetClientRect(HWindow, R);
  98.  
  99.   { Draw the color panes using a solid brush of the appropriate color }
  100.   S := R.bottom div 17;
  101.   for Y := 0 to 15 do
  102.     for X := 0 to 2 do
  103.     begin
  104.       OldBrush := SelectObject(PaintDC,
  105.         CreateSolidBrush(Colors[X, Y]));
  106.       Rectangle(PaintDC, X * S, Y * S, (X + 1) * S + 1, (Y + 1) * S + 1);
  107.       DeleteObject(SelectObject(PaintDC, OldBrush));
  108.     end;
  109.  
  110.   { Paint the frame around the current color pane }
  111.   SelectObject(PaintDC, GetStockObject(null_brush));
  112.   Rectangle(PaintDC, 0, S * 16, R.right, R.bottom);
  113.   
  114.   { Paint the current colors square with the current colors }
  115.   OldPen := SelectObject(PaintDC, CreatePen(ps_Solid, 5, State^.PenColor));
  116.   OldBrush := SelectObject(PaintDC, CreateSolidBrush(State^.BrushColor));
  117.   Rectangle(PaintDC, 3, S * 16 + 3, R.right - 3, R.bottom - 3);
  118.  
  119.   { Restore the DC to its original state }
  120.   DeleteObject(SelectObject(PaintDC, OldBrush));
  121.   DeleteObject(SelectObject(PaintDC, OldPen));
  122. end;
  123.  
  124. { Select the current pen and brush colors in response to mouse clicks.
  125. }
  126. procedure TPalette.WMLButtonDown(var Msg: TMessage);
  127. begin
  128.   SelectColor(Msg, State^.PenColor);
  129. end;
  130.  
  131. procedure TPalette.WMRButtonDown(var Msg: TMessage);
  132. begin
  133.   SelectColor(Msg, State^.BrushColor);
  134. end;
  135.  
  136. end.